perm filename RESPC.F4[PAG,LCS]8 blob
sn#390624 filedate 1978-10-24 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE RESPC
C00033 ENDMK
Cā;
SUBROUTINE RESPC
COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
1 RCLEF(0/7) /IVV/IV(1)
COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
INTEGER DUMMY
COMMON /PX/PN(1) /Q/Q(1)
1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
C RQ(2) IS R4, RQ(3) IS R5 ETC.
IF(NMPG.NE.'PAGEA')GO TO 2000
C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
RNEXT=0
2000 SPCNT=1.0
JX=0
JCEN=0
C FLAG FOR CENTERED RESTS.
XT=0
JK=1
C JK IS USED AT END. IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
PX=0
CALL SHFT1(KQ)
KK=L
CC TYPE 3001,L
C DELETES EXTRA BAR LINES, ETC.
IF(IPG)CALL RESTS
C??? IF(N)RETURN
C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
CALL SHIFT
C L=NUMBER OF ITEMS FOR RHY RECONS.
JJ2=L+2
C FOR WDCNT IN .PAG FILE
N=0
S=-100
R=0
KCLEF=0
NOGRCE=-1
C GRACE NOTE FLAG
TTT=0
C FOR IRREG. NUMS. OF STAVES.
C******** BIG LOOP ***************
161 DO 601 K=1,L
R=CODEN(KPN,K,Q,J)
RZ=Q(J)
CX J=KPN(K)
CC N=N+1
CC NN(N)=0
CC MM(N)=J+3
CALL MMNN(3)
NN(N)=-R
C MAKE ALL CODE NUMS NEG. AT FIRST. CHANGE 1,2,3,4,17,18 LATER
CX R=Q(J+1)
IF(R.GT.2)GO TO 1801
IF(Q(J+2).GT.TTT)TTT=Q(J+2)
C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
IF(R.NE.1)GO TO 2801
IF(RZ.LT.7)GO TO 601
IF(Q(J+9).LE.0)GO TO 601
C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
IF(Q(J+9).NE.4./88.)GO TO 702
CC IF(Q(J+9).GT..05)GO TO 702
CC IF(Q(J+8).EQ.1000)GO TO 601
C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
NOGRCE=0
GO TO 601
CCC2801 IF(R.NE.2)GO TO 1801
2801 RS=Q(J+7)
IF(RZ.LT.7)GO TO 3801
C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
CXX NN(N)=-NN(N)
IF(Q(J+9).NE.0)Q(J+9)=-1
C SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
IF(Q(J+8).EQ.0)GO TO 601
C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
IF(RS.LE.0)GO TO 601
C SKIP RESTS WITH NO RHYTHM VALUE IN P7
GO TO 702
C??? NOW MAKE CODE NUM. POS.
CC NN(N)=R
CC GO TO 688
3801 IF(RZ.LT.5)GO TO 601
IF(RS.LE.0)GO TO 601
IF(IPG)GO TO 702
IF(RZ.LT.6)GO TO 702
RS=Q(J+3)
C GET POS. OF CENTERED WHOLE REST
TT=0
B=Q(J+2)
C GET THE STAFF NUM.
DO 602 M=1,L
T=CODEN(KPN,M,Q,JJ)
A=Q(JJ+3)
C GET POS. OF ITEM
IF(A.GT.RS)GO TO 602
C JUMP IF ITEM IS TO RIGHT OF REST
IF(T.NE.4)GO TO 602
C IS THE ITEM A BAR LINE
IF(A.GT.TT)TT=A
C FINDS BAR LINE CLOSEST TO LEFT OF REST
602 CONTINUE
C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
T=20000
A=20000
C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
DO 613 M=1,L
IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
IF(Q(JJ).LT.7)GO TO 609
C SKIP IF RHYTH NOT IN P9
IF(Q(JJ+9).LT..05)GO TO 613
C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
609 B=Q(JJ+3)
C POS. OF ITEM
X=B-TT
IF(X)GO TO 613
C JUMP IF ITEM IS TOO FAR TO LEFT
IF(X.GT.A)GO TO 613
A=X
T=B
C T = POS OF NOTE OR REST NEAREST BAR, ETC.
613 CONTINUE
IF(T.NE.20000)GO TO 612
C JUMP IF NOTE OR REST FOUND
JCEN=-1
GO TO 1801
612 Q(J+3)=T
C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
1801 IF(R.LT.4)GO TO 702
IF(R.EQ.17)GO TO 1702
IF(R.EQ.18)GO TO 1702
IF(R.EQ.10)GO TO 702
C FOUND A NUMBER. USE THIS IN RESTP
IF(R.LE.7)GO TO 30
IF(R.NE.44)GO TO 601
IF(RZ.EQ.2)GO TO 601
C RZ=2= BAR LINE ON UPPER STAFF
IF(Q(J+6).EQ.0)GO TO 601
IF(Q(J+5).EQ.0)GO TO 601
C GETS LEFT END OF LINES, CRESC., DASHES.
GO TO 604
30 IF(R.NE.7)GO TO 605
IF(RZ.LT.5)GO TO 604
C JUMP FOR STANDARD TRILL
RS=Q(J+7)
IF(RS.EQ.1)GO TO 604
IF(ABS(RS).GE.3)GO TO 604
C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
GO TO 601
605 IF(R.NE.4)GO TO 604
IF(RZ.LE.3)GO TO 702
C JUMP IF IT IS A BAR LINE
CC IF(RZ.LT.4)GO TO 601
IF(Q(J+6).NE.0)GO TO 604
C GO GET OTHER POS OF LINE
GO TO 601
1702 IF(Q(J+4).NE.0)GO TO 601
IF(Q(J+2).NE.0)GO TO 601
C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
702 NN(N)=-NN(N)
CC702 NN(N)=R
GO TO 601
C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
604 CALL MMNN(6)
C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS (PUTS -1 INTO NN(X))
CCXX NN(N)=-1
IF(R.NE.6)GO TO 601
C NEXT FOR BEAMS
IF(RZ.LT.8)GO TO 608
IF(Q(J+10).EQ.0)GO TO 608
IF(Q(J+8))GO TO 608
C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
IF(Q(J+7).GT.0)CALL MMNN(8)
C NEXT SHIFTS P8 OF COMPOSITE BEAMS
608 IF(RZ.LT.7)GO TO 601
IF(Q(J+7))GO TO 688
C P7 IS NEG FOR TREMOLO
IF(Q(J+8).EQ.0)GO TO 601
C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
688 IF(Q(J+9).GT.0)CALL MMNN(9)
C FOUND A POS. IN P9
601 CONTINUE
KPG=TTT+1
C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
C NEXT SORTS THE POINTS
6000 J=1
CC610 IF(NN(J).NE.-16)GO TO 1610
C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1) PUTS ALL AT SAME P3 LOC.
CC K=MM(J)
CC IF(Q(K-3).LT.8)GO TO 1610
CC IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
CC GO TO 710
CC1610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
CALL EXCHG(MM(J),NN(J))
C ABOVE EXCHGS --(J) AND --(J+1)
IF(J.EQ.1)GO TO 710
J=J-1
GO TO 610
710 J=J+1
IF(J.LT.N)GO TO 610
C NOW ALL SORTED
CALL FNDEND(R)
CALL SHFTQ(R)
C SHIFTS TO PROPER HORIZ. POS.
IF(IPG)CALL RESTP
C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
IF(N.LE.0)GO TO 122
C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
DO 119 K=1,150
119 HH(K)=0
C HH ARRAY WILL HOLD FINAL COMPOSITE.
G(1)=0
E(1)=0
F(1)=0
RN(1500)=0
RN(2500)=0
ST=0
C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
KE=0
J=1000
933 JJ=1500
JJJ=2000
T=0
M=0
A=0
B=0
DO 33 K=1,N
IF(NORH(KK))GO TO 33
CC KK=NN(K)
CC IF(KK.EQ.0)GO TO 33
CC IF(KK.EQ.4)GO TO 2133
CC IF(KK.EQ.17)GO TO 2133
C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
CC IF(KK.EQ.18)GO TO 2133
CC IF(KK.GT.2)GO TO 33
2133 LL=MM(K)-3
IF(KK.LE.2)GO TO 1133
RH=.01
C RHYTHMIC VALUE OF BARLINE, METER, KSIG
CCC IF(KK.NE.4)RH=.6
GO TO 3133
1133 IF(Q(LL+2).NE.ST)GO TO 33
C JUMP IF NOT ON RIGHT STAFF
RA=9
IF(KK.EQ.2)RA=7
IF(Q(LL).LT.RA-2)GO TO 33
C JUMP IF WDCNT IS TOO SHORT
IF(KK.EQ.1)GO TO 433
IF(Q(LL).LT.6)GO TO 433
C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
RZ=Q(LL+8)
C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
IF(RZ.LE.0)GO TO 433
Q(LL+7)=2
C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
IF(RZ.LT.8)GO TO 433
Q(LL+5)=-3
C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
RZ=RZ/2.0
CC RZ=IFIX(RZ/2.0)+1.0
IF(RZ.GT.6)RZ=6
C LIMIT OF 8 ON RHYTH VAL.
Q(LL+7)=RZ
433 RH=Q(LL+IFIX(RA))
IF(RH.EQ.0)GO TO 33
3133 RZ=Q(LL+3)
IF(ZERO(RZ,A).EQ.0)GO TO 133
C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
RRH=RH
C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
TT=T
C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
J=J+1
C UPDATE COUNTER IN POSITION ARRAY
T=T+RH
C ADD TO TOTAL RHYTHM
RN(J)=T
A=Q(LL+3)
C SAVE POS. OF THIS NOTE.
GO TO 33
133 IF(RH.EQ.RHH)GO TO 33
C IGNORE 2ND RHYTH IF SAME AS FIRST
IF(ZERO(RZ,B).EQ.0)GO TO 333
C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
TTT=TT
C SAVE TOTAL RHYTHM TO THIS POINT.
TT=TT+RH
JJ=JJ+1
C UPDATE COUNTER FOR 2ND ARRAY
RN(JJ)=TT
RRRH=RH
B=A
GO TO 33
333 IF(RH.EQ.RRRH)GO TO 33
TTT=TTT+RH
JJJ=JJJ+1
RN(JJJ)=TTT
33 CONTINUE
C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
IF(ST.NE.0)GO TO 733
KE=J-999
C TOTAL NUM OF RHYTHMS ON STAFF1.
CC IF(JPG.EQ.0)GO TO 2233
IF(KPG.LE.1)GO TO 2233
C KPG=0=PARTS; =1=PAGE, 1 STAFF
C JUMP IF ONLY ONE STAFF
C****733 KF=J-2499
C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
733 ST=ST+1
IF(ST.GT.1)GO TO 833
C JUMP IF ALL STAVES HAVE BEEN READ.
1233 J=2500
GO TO 933
833 IF(J.NE.2500)GO TO 1533
C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
2233 CALL RLOOP(HH,E,KE)
C FOR SINGLE STAFF OF RHYTHM
KL=KE
GO TO 1333
1533 K=1
L=1
M=0
19 KK=K
LL=L
1 SM=10000
K=K+1
IF(K.GT.KE)GO TO 10
4 L=L+1
Y=F(L)
B=Y-F(L-1)
IF(B.LT.SM)SM=B
2 X=E(K)
A=X-E(K-1)
C A AND B HAVE TRUE DURATIONS NOW
IF(A.LT.SM)SM=A
C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
IF(ZERO(X,Y).EQ.0)GO TO 3
C JUMP IF EQUAL RHYTHS
IF(X.GT.Y)GO TO 4
K=K+1
C STEP FORWARD UNTIL X IS .GT. Y
GO TO 2
3 IF(K.NE.KK+1)GO TO 13
IF(L.NE.LL+1)GO TO 14
M=M+1
G(M)=E(KK)
GO TO 19
13 IF(L.NE.LL+1)GO TO 15
DO 16 J=KK,K-1
M=M+1
16 G(M)=E(J)
GO TO 19
14 DO 17 J=LL,L-1
M=M+1
17 G(M)=F(J)
GO TO 19
15 XM=SM-.001
M=M+1
P=E(KK)
G(M)=P
7 KK=KK+1
LL=LL+1
YM=SM*1.5
C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
S=P
T=P
27 A=E(KK)
B=F(LL)
IF(ZERO(A,B).EQ.0)GO TO 19
X=ZERO(A,P)
Y=ZERO(B,P)
C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
S=E(KK-1)
T=F(LL-1)
9 IF(A-S.LT.X-.01)X=ZERO(A,S)
IF(B-T.LT.Y-.01)Y=ZERO(B,T)
IF(A.GT.B+.01)GO TO 8
B=A
KK=KK+1
62 IF(X.GT.YM)GO TO 5
IF(X.EQ.0)GO TO 27
P=P+SM
25 M=M+1
G(M)=P
GO TO 27
5 P=P+SM
IF(P)GO TO 203
C IF(P)ERROR
IF(P.LT.B-.01)GO TO 5
GO TO 25
8 X=Y
LL=LL+1
GO TO 62
10 M=M+1
G(M)=E(KE)
CC TYPE 410,(E(K),K=1,KE)
CC TYPE 410,(F(K),K=1,KF)
CC TYPE 410,(G(K),K=1,M)
CBCB WRITE(21,410)(E(K),K=1,KE)
CB WRITE(21,410)(F(K),K=1,KF)
CB WRITE(21,410)(G(K),K=1,M)
410 FORMAT(10F7.2)
C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
1033 JJ=1
H(1)=0
J=1
K=2
L=2
511 IF(J.EQ.M)GO TO 911
J=J+1
X=G(J)
1211 A=E(K)
B=F(L)
Y=ZERO(X,A)
Z=ZERO(X,B)
IF(A-B.GT..01)GO TO 1111
IF(Y.EQ.0)GO TO 1311
IF(X.LT.A-.01)GO TO 1111
K=K+1
1411 JJ=JJ+1
H(JJ)=-A
GO TO 1211
1111 IF(Z.EQ.0)GO TO 1311
IF(X.LT.B-.01)GO TO 1311
L=L+1
A=B
GO TO 1411
1311 JJ=JJ+1
H(JJ)=X
IF(Y.EQ.0)GO TO 611
IF(Z.EQ.0)GO TO 711
IF(ZERO(A,B).EQ.0)GO TO 511
P=A
IF(P.GT.B+.01)GO TO 811
IF(P.GT.X+.01)GO TO 511
K=K+1
GO TO 1011
811 P=B
IF(P.GT.X+.01)GO TO 511
L=L+1
1011 JJ=JJ+1
H(JJ)=-P
C NON-SPACED RHYTHS ARE NEG.
GO TO 511
611 K=K+1
IF(Z.GT.0)GO TO 511
711 L=L+1
GO TO 511
911 IF(HH(2).EQ.0)GO TO 2011
K=2
J=2
L=1
HHH(1)=0
1511 IF(J.GT.JJ)GO TO 1811
P=H(J)
A=ABS(P)
B=ABS(HH(K))
IF(ZERO(B,A).EQ.0)GO TO 1611
IF(A.GT.B)GO TO 1711
J=J+1
GO TO 1911
1711 P=HH(K)
GO TO 2211
1611 J=J+1
2211 K=K+1
1911 L=L+1
HHH(L)=P
GO TO 1511
2011 CALL RLOOP(HH,H,JJ)
KL=JJ
GO TO 2111
1811 CALL RLOOP(HH,HHH,L)
KL=L
2111 IF(ST.GE.KPG)GO TO 1333
CALL RLOOP(E,G,M)
KE=M
C GO WAY BACK AND READ ANOTHER LINE.
GO TO 1233
1333 E(1)=0
GO TO 2333
TYPE 410,(HH(K),K=1,KL)
WRITE(21,410)(HH(K),K=1,KL)
2333 JD=1
C JD IS COUNTER FOR DUMMY POSITIONS.
DUMMY(1)=1
ST=0
183 B=0
LL=2
DO 181 K=1,N
IF(NORH(L))GO TO 181
C LOOK FOR DUMMY RHYTHMS.
IF(L.LE.2)GO TO 2184
RZ=.01
C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
GO TO 1184
2184 LF=MM(K)
IF(Q(LF-1).NE.ST)GO TO 181
C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
J=6
IF(L.EQ.2)J=4
RZ=Q(LF+J)
1184 B=B+RZ
184 V=ABS(HH(LL))
IF(ZERO(B,V).GT.0)GO TO 182
C FOUND RHYTH MATCH
JD=JD+1
DUMMY(JD)=LL
LL=LL+1
GO TO 181
182 IF(B.LT.V-.01)GO TO 181
LL=LL+1
GO TO 184
181 CONTINUE
ST=ST+1
IF(ST.LT.KPG)GO TO 183
C NEXT SORT DUMMY ARRAY
J=0
185 DO 186 K=2,JD
IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
DO 188 LL=K,JD
188 DUMMY(LL-1)=DUMMY(LL)
JD=JD-1
GO TO 185
187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
CALL EXCH(DUMMY(K),DUMMY(K-1))
GO TO 185
186 CONTINUE
C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
PX=0
LF=0
K=1
V=0
81 K=K+1
IF(K.GT.KL)GO TO 1433
B=HH(K)
A=B-V
V=B
IF(V)GO TO 82
85 W=V
IF(A.GT.0.01)GO TO 89
C .GT. BECAUSE OF ROUND-OFF ERROR
T=5
IF(HH(K+1)-V.LE..01)T=2
PX=PX+T
C THIS FOR BARS, KSIG, METER
GO TO 189
89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
CC89 PX=PX+PFIBX(A)
189 E(K)=PX
IF(LF.NE.0)GO TO 86
GO TO 81
82 LF=K
83 K=K+1
V=HH(K)
IF(V)GO TO 83
A=V-W
GO TO 85
86 LL=LF-1
D=E(K)-E(LL)
87 S=-HH(LF)-HH(LL)
T=HH(K)-HH(LL)
T=S/T
C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
E(LF)=E(LL)+D*T
LF=LF+1
IF(LF.NE.K)GO TO 87
LF=0
GO TO 81
1433 GO TO 2433
TYPE 410,(E(K),K=1,KL)
WRITE(21,410)(E(K),K=1,KL)
C 5 IS SPACE AFTER 1ST BARLINE
2433 R8=RNEXT
C POS OF 1ST BAR = END OF PREV. LINE
IF(ENDLN.EQ.0)RNEXT=9
C MAKES ROOM FOR 1ST CLEF.
KL=KL-1
J=0
R5=0
KK=1
JD=1
W=0
LF=0
DO 80 K=1,N
IF(NORH(L))GO TO 80
A=Q(MM(K))
IF(ZERO(A,W).EQ.0)GO TO 80
C SKIP IF SAME POS OF NOTE OR REST.
W=A
R7=R8
190 J=J+1
IF(J.LE.KL)GO TO 290
203 FORMAT(' FOUND CENTERED WHOLE REST!')
LL=0
IF(JCEN.GE.0)GO TO 220
TYPE 203
GO TO 121
220 JJJ=-1
L=0
120 W=LL
A=0
DO 124 K=1,N
LF=NN(K)
IF(LF.GT.2)GO TO 124
IF(LF.LE.0)GO TO 124
KE=MM(K)
IF(Q(KE-1).NE.W)GO TO 124
C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
JD=6
IF(LF.EQ.2)JD=4
A=A+Q(KE+JD)
124 CONTINUE
TYPE 123,LL,A
LL=LL+1
IF(L.EQ.0)L=A*100.+.5
C SAVE NUM. OF BEATS FIRST TIME.
IF(L.NE.A*100.+.5)JJJ=0
C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
IF(LL.LT.KPG)GO TO 120
IF(JJJ.NE.0)GO TO 121
JJJ=0
DO 320 K=2,JJ
A=HH(K)-HH(K-1)
IF(A.LE..01)GO TO 320
C SKIP BAR LINE VALUES (.01)
JJJ=JJJ+1
HH(JJJ)=4./A
C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
320 CONTINUE
TYPE 420,(HH(K),K=1,JJJ)
PAUSE
1' ****COMPOSITE RHYTHM ERROR - AND/OR MISALIGNED NOTES****'
GO TO 90
420 FORMAT(10F8.2)
123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
121 PAUSE' *****RHYTHM MISMATCH*****'
GO TO 90
290 IF(DUMMY(JD).NE.J)GO TO 190
JD=JD+1
90 R8=RNEXT+E(J)
R4=R5
R5=A
X=(R8-R7)/(R5-R4)
S=R7-R4*X
DO 91 L=KK,K
LL=MM(L)
91 Q(LL)=S+X*Q(LL)
KK=K+1
80 CONTINUE
IF(KK.GT.K)GO TO 180
C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
R7=Q(LL)-R5
C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
DO 280 L=KK,K
LL=MM(L)
280 Q(LL)=R7+Q(LL)
180 JJ=JJ2-2
L=JJ2
M=0
C FLAG FOR REST AT START OF LINE
JJJ=-1
C FLAG FOR 1ST BAR OF LINE 12/77
V=0
ACCI=0
DO 12 J=1,JJ
R=CODEN(KPN,J,Q,LA)
CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
IF(R.EQ.4)GO TO 680
IF(M)GO TO 780
IF(R.NE.2)GO TO 780
C NEXT FOR RESTS
ACCI=ACCI+.5
C ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
C SHOULD WE ALSO CONSIDER CLEFS?? MAYBE ADD LATER.
IF(KBR.EQ.0)GO TO 12
C LOOK FOR RESTS AT FRONT OF LINE.
X=0
CALL TURN(J,JJ,1,X)
PGTRN(KBR)=PGTRN(KBR)+X
M=-1
780 IF(R.NE.1)GO TO 12
IF(V.NE.Q(LA+3))GO TO 782
IF(JACC)GO TO 781
782 ACCI=ACCI+.5
IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
JACC=-1
V=1
C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
CCCC V=RSTFAC(IFIX(Q(LA+2))+1)
CC ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
CCCC ACCI=ACCI+ACCISZ*V
ACCI=ACCI+V
C ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
V=Q(LA+3)
781 M=-1
IF(NOGRCE)GO TO 12
C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
C FOUND A NOTE
IF(Q(LA+9).GT.0.05)GO TO 12
C JUMP IF NOT A GRACE NOTE
R=Q(LA+2)
C THE STAFF NUM.
DO 580 LF=J+1,JJ
IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
IF(Q(JD+2).NE.R)GO TO 580
IF(Q(JD).LT.7)GO TO 580
IF(Q(JD+9).EQ.0)GO TO 580
C CHORD NOTE
R4=Q(LA+3)
CC R4=Q(LA+3)-1
R5=Q(JD+3)
C THE STAFF # IS IN R2
R8=RSTFAC(IFIX(R2+1))+.5
IF(Q(JD+4).LT.80)R8=R8*2
C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
R8=R5-R8
CC R8=R5-R8-1
CCC IF(R4.EQ.R5)GO TO 12
IF(R4.NE.R5)GO TO 480
C GRACE NOTE AT START OF LINE ***** FIX THIS????
DO 880 KE=1,LF-1
880 Q(KPN(KE)+3)=R8
C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
GO TO 12
480 R2=Q(LA+2)
R9=R5
CALL PTMOVE(Q,KPN)
CC TYPE 9999,Q(J+3),Q(JD+3)
CC9999 FORMAT(2F)
GO TO 12
580 CONTINUE
GO TO 12
C ABOVE FOR GRACE NOTE SPACING.
680 KBR=KBR+1
C BAR LINE COUNTER
T=Q(LA+3)
C TOTAL SPACE
X=0
CALL TURN(J-1,1,-1,X)
CALL TURN(J+1,JJ,1,X)
222 PGTRN(KBR)=X
C FINDS PAGE-TURN POSSIBILITIES
C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
BFAC=.8
CCC BFAC=.756
IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
CC IF(KPG.LE.1)GO TO 3112
C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
CC R=RSTFAC(1)
CC DO 5112 K=2,KPG
CC5112 IF(R.NE.RSTFAC(K))GO TO 6112
CC GO TO 3112
C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
C FIND LINE WITH MOST ACTIVITY.
C ALL THIS SORT OF WORKS. SOMEDAY REVIEW IT.********
CC6112 DO 1112 K=1,8
CC1112 RN(K)=0
CC DO 112 K=JK,J-1
CC R=CODEN(KPN,K,Q,JD)
CC IF(R.GT.3.)GO TO 112
CC A=1.0
C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
CC IF(R.EQ.2)A=0.6
C SKIP NON-RHYTHM CHORD NOTES. RESTS ARE CONSIDERED LESS IMPORTANT.
CC IF(R.NE.1)GO TO 4112
CC IF(Q(JD).LT.7)GO TO 112
CC IF(Q(JD+9).LE.0)GO TO 112
CC4112 LF=Q(JD+2)+1
CC RN(LF)=RN(LF)+A
CC112 CONTINUE
CC JD=1
CC B=RN(1)*RSTFAC(1)
CC DO 2112 K=2,8
CC A=RN(K)*RSTFAC(K)
CC IF(A.LE.B)GO TO 2112
CC JD=K
CC B=A
CC2112 CONTINUE
CC BFAC=BFAC*(RSTFAC(JD)+.1)
C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
CXX BFAC=.84*RSTFAC(JD)
3112 IF(JJJ)RNEXT=RNEXT-6
C JJJ=-1 IF 1ST BAR OF LINE. 12/77
JJJ=0
BARS(KBR)=(T-RNEXT+ACCI)*BFAC
C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
ACCI=0
C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
K=J
JK=J+1
C SET UP POINTER FOR NEXT BAR'S ITEMS.
RNEXT=T
12 CONTINUE
IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
RNEXT=RNEXT+3
JJ2=L
C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
CC???380 LCNT=0
CC??? NDPY=0
C JJ2 IS END OF PNTR DATA
JPQ=KPN(JJ2-1)+1
CALL PUTEXT(NMPG,'PAG')
CALL EXTOUT(RSTFAC,128)
CALL EXTOUT(PN,JJ2)
CALL EXTOUT(Q,JPQ)
CALL FINEXT
LASTNM=NMPG
NMPG=NMPG+2
IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
122 ENDLN=RNEXT
END